home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / src / wdistrib.c < prev    next >
Text File  |  1994-01-03  |  41KB  |  1,675 lines
  1. # include "Distribu.h"
  2. # include "yyADistr.w"
  3. # include <stdio.h>
  4. # if defined __STDC__ | defined __cplusplus
  5. #  include <stdlib.h>
  6. # else
  7.    extern void exit ();
  8. # endif
  9. # include "Tree.h"
  10. # include "Definiti.h"
  11.  
  12. # ifndef NULL
  13. # define NULL 0L
  14. # endif
  15. # ifndef false
  16. # define false 0
  17. # endif
  18. # ifndef true
  19. # define true 1
  20. # endif
  21.  
  22. # ifdef yyInline
  23. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) \
  24.   if ((ptr = (tree) free) >= (tree) max) ptr = alloc (); \
  25.   free += nodesize [kind]; \
  26.   ptr->yyHead.yyMark = 0; \
  27.   ptr->Kind = kind;
  28. # else
  29. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) ptr = make (kind);
  30. # endif
  31.  
  32. # define yyWrite(s) (void) fputs (s, yyf)
  33. # define yyWriteNl (void) fputc ('\n', yyf)
  34.  
  35. # line 51 "AdaptDistributions.puma"
  36.  
  37. # include "Idents.h"
  38. # include "StringMe.h"
  39.  
  40. # include "protocol.h"        /* protocol the changes            */
  41. # include "permutat.h"    /* data structure for permutations */
  42.  
  43. # include "NormalAr.h"    /* normalization of arrays */
  44.  
  45. # include "ShowDefs.h"        /* SemFile                 */
  46. # include "Transfor.h"       /* ExpToVarParam           */
  47.  
  48. static int host_arrays, distributed_arrays;
  49.  
  50.  
  51.  
  52. static FILE * yyf = stdout;
  53.  
  54. static void yyAbort
  55. # ifdef __cplusplus
  56.  (char * yyFunction)
  57. # else
  58.  (yyFunction) char * yyFunction;
  59. # endif
  60. {
  61.  (void) fprintf (stderr, "Error: module AdaptDistributions, routine %s failed\n", yyFunction);
  62.  exit (1);
  63. }
  64.  
  65. void AdaptDistributions ARGS((tTree t));
  66. static void TransformDistributions ARGS((tTree t));
  67. static void TransformDeclDistributions ARGS((tTree decls));
  68. static void SwitchDistributedDimensions ARGS((tDefinitions Obj));
  69. static void TransformACFDistributions ARGS((tTree t));
  70. static void WherePermutation ARGS((tTree t, Permutation p));
  71. static void TransformStmtDistributions ARGS((tTree t));
  72. static void TransformParamDistributions ARGS((tTree t, bool allowed));
  73. static void TransformIndexDistributions ARGS((tTree t));
  74. static Permutation PermuteExpression ARGS((tTree t));
  75. static Permutation GetObjectPermutation ARGS((tDefinitions obj));
  76. static Permutation PermuteIntrinsicFunction ARGS((tTree f));
  77. static Permutation PermuteIntrinsicParameters ARGS((tTree p));
  78. static Permutation PermuteReductionParameters ARGS((tTree p));
  79. static Permutation PermuteCShiftParameters ARGS((tTree p));
  80. static Permutation PermuteTransposeParameters ARGS((tTree p));
  81. static Permutation PermuteSpreadParameters ARGS((tTree p));
  82. static tTree ChangeConstValue ARGS((tTree exp, int val));
  83. static void PermuteIntrinsicSubroutine ARGS((tIdent name, tTree params));
  84. static void PermuteGlobalGetParams ARGS((tTree param_list));
  85. static void PermuteGlobalSendParams ARGS((tTree param_list));
  86. static void SwitchGetSendIndexes ARGS((Permutation ap, tTree indexlist, int n));
  87. static void SwitchGetSendIndex ARGS((Permutation ap, tTree index));
  88. static void ResolveDistTranspose ARGS((tTree t, Permutation dist1, Permutation dist2));
  89.  
  90. void AdaptDistributions
  91. # if defined __STDC__ | defined __cplusplus
  92. (register tTree t)
  93. # else
  94. (t)
  95.  register tTree t;
  96. # endif
  97. {
  98.   if (t == NoTree) return;
  99.   if (t->Kind == kCOMP_UNIT) {
  100. # line 75 "AdaptDistributions.puma"
  101.   {
  102. # line 76 "AdaptDistributions.puma"
  103.    open_protocol ("adaptor.dis");
  104. # line 77 "AdaptDistributions.puma"
  105.    TransformDistributions (t->COMP_UNIT.COMP_ELEMENTS);
  106. # line 78 "AdaptDistributions.puma"
  107.    close_protocol ();
  108.   }
  109.    return;
  110.  
  111.   }
  112. ;
  113. }
  114.  
  115. static void TransformDistributions
  116. # if defined __STDC__ | defined __cplusplus
  117. (register tTree t)
  118. # else
  119. (t)
  120.  register tTree t;
  121. # endif
  122. {
  123.   if (t == NoTree) return;
  124.  
  125.   switch (t->Kind) {
  126.   case kDECL_EMPTY:
  127. # line 91 "AdaptDistributions.puma"
  128.    return;
  129.  
  130.   case kDECL_LIST:
  131. # line 94 "AdaptDistributions.puma"
  132.   {
  133. # line 95 "AdaptDistributions.puma"
  134.    TransformDistributions (t->DECL_LIST.Elem);
  135. # line 96 "AdaptDistributions.puma"
  136.    TransformDistributions (t->DECL_LIST.Next);
  137.   }
  138.    return;
  139.  
  140.   case kPROGRAM_DECL:
  141. # line 107 "AdaptDistributions.puma"
  142.  {
  143.   tDefinitions Obj;
  144.   {
  145. # line 108 "AdaptDistributions.puma"
  146.    set_protocol_unit (t);
  147. # line 109 "AdaptDistributions.puma"
  148.  
  149. # line 110 "AdaptDistributions.puma"
  150.    Obj = GetDeclEntry (t->PROGRAM_DECL.Name, GetUnitEntries ());
  151. # line 111 "AdaptDistributions.puma"
  152.    OpenScope (Obj->ProcObject.Declarations);
  153. # line 112 "AdaptDistributions.puma"
  154.    TransformDistributions (t->PROGRAM_DECL.PROGRAM_BODY);
  155. # line 113 "AdaptDistributions.puma"
  156.    CloseScope ();
  157.   }
  158.    return;
  159.  }
  160.  
  161.   case kPROC_DECL:
  162. # line 116 "AdaptDistributions.puma"
  163.  {
  164.   tDefinitions Obj;
  165.   {
  166. # line 117 "AdaptDistributions.puma"
  167.    set_protocol_unit (t);
  168. # line 118 "AdaptDistributions.puma"
  169.  
  170. # line 119 "AdaptDistributions.puma"
  171.    Obj = GetDeclEntry (t->PROC_DECL.Name, GetUnitEntries ());
  172. # line 120 "AdaptDistributions.puma"
  173.    OpenScope (Obj->ProcObject.Declarations);
  174. # line 121 "AdaptDistributions.puma"
  175.    TransformDistributions (t->PROC_DECL.PROC_BODY);
  176. # line 122 "AdaptDistributions.puma"
  177.    CloseScope ();
  178.   }
  179.    return;
  180.  }
  181.  
  182.   case kFUNC_DECL:
  183. # line 125 "AdaptDistributions.puma"
  184.  {
  185.   tDefinitions Obj;
  186.   {
  187. # line 126 "AdaptDistributions.puma"
  188.    set_protocol_unit (t);
  189. # line 127 "AdaptDistributions.puma"
  190.  
  191. # line 128 "AdaptDistributions.puma"
  192.    Obj = GetDeclEntry (t->FUNC_DECL.Name, GetUnitEntries ());
  193. # line 129 "AdaptDistributions.puma"
  194.    OpenScope (Obj->FuncObject.Declarations);
  195. # line 130 "AdaptDistributions.puma"
  196.    TransformDistributions (t->FUNC_DECL.FUNC_BODY);
  197. # line 131 "AdaptDistributions.puma"
  198.    CloseScope ();
  199.   }
  200.    return;
  201.  }
  202.  
  203.   case kMODULE_DECL:
  204. # line 134 "AdaptDistributions.puma"
  205.   {
  206. # line 135 "AdaptDistributions.puma"
  207.    tree_error_protocol ("MODULE not supported", t);
  208.   }
  209.    return;
  210.  
  211.   case kBLOCK_DATA_DECL:
  212. # line 138 "AdaptDistributions.puma"
  213.  {
  214.   tDefinitions Obj;
  215.   {
  216. # line 139 "AdaptDistributions.puma"
  217.    set_protocol_unit (t);
  218. # line 140 "AdaptDistributions.puma"
  219.  
  220. # line 141 "AdaptDistributions.puma"
  221.    Obj = GetDeclEntry (t->BLOCK_DATA_DECL.Name, GetUnitEntries ());
  222. # line 142 "AdaptDistributions.puma"
  223.    OpenScope (Obj->BlockObject.Declarations);
  224. # line 143 "AdaptDistributions.puma"
  225.    TransformDistributions (t->BLOCK_DATA_DECL.DATA_BODY);
  226. # line 144 "AdaptDistributions.puma"
  227.    CloseScope ();
  228.   }
  229.    return;
  230.  }
  231.  
  232.   case kBODY_NODE:
  233.   if (t->BODY_NODE.INTERNALS->Kind == kDECL_EMPTY) {
  234. # line 147 "AdaptDistributions.puma"
  235.   {
  236. # line 148 "AdaptDistributions.puma"
  237.    TransformDeclDistributions (t->BODY_NODE.DECLS);
  238. # line 149 "AdaptDistributions.puma"
  239.    TransformACFDistributions (t->BODY_NODE.STATS);
  240. # line 150 "AdaptDistributions.puma"
  241.    NormalArrays (t);
  242.   }
  243.    return;
  244.  
  245.   }
  246.   break;
  247.   }
  248.  
  249. ;
  250. }
  251.  
  252. static void TransformDeclDistributions
  253. # if defined __STDC__ | defined __cplusplus
  254. (register tTree decls)
  255. # else
  256. (decls)
  257.  register tTree decls;
  258. # endif
  259. {
  260.   if (decls == NoTree) return;
  261.   if (decls->Kind == kDECL_EMPTY) {
  262. # line 161 "AdaptDistributions.puma"
  263.    return;
  264.  
  265.   }
  266.   if (decls->Kind == kDECL_LIST) {
  267. # line 164 "AdaptDistributions.puma"
  268.   {
  269. # line 165 "AdaptDistributions.puma"
  270.    TransformDeclDistributions (decls->DECL_LIST.Elem);
  271. # line 166 "AdaptDistributions.puma"
  272.    TransformDeclDistributions (decls->DECL_LIST.Next);
  273.   }
  274.    return;
  275.  
  276.   }
  277.   if (decls->Kind == kVAR_DECL) {
  278. # line 169 "AdaptDistributions.puma"
  279.  {
  280.   tDefinitions Obj;
  281.   {
  282. # line 171 "AdaptDistributions.puma"
  283.  
  284. # line 172 "AdaptDistributions.puma"
  285.    Obj = GetLocalDecl (decls->VAR_DECL.Name);
  286. # line 174 "AdaptDistributions.puma"
  287.    if (! (VarDistribution (Obj) == 1)) goto yyL3;
  288.   {
  289. # line 175 "AdaptDistributions.puma"
  290.    SwitchDistributedDimensions (Obj);
  291.   }
  292.   }
  293.    return;
  294.  }
  295. yyL3:;
  296.  
  297.   }
  298. ;
  299. }
  300.  
  301. static void SwitchDistributedDimensions
  302. # if defined __STDC__ | defined __cplusplus
  303. (register tDefinitions Obj)
  304. # else
  305. (Obj)
  306.  register tDefinitions Obj;
  307. # endif
  308. {
  309. # line 180 "AdaptDistributions.puma"
  310.  
  311. Permutation perm;
  312.  
  313.   if (Obj == NoDefinitions) return;
  314.   if (Obj->Kind == kVarObject) {
  315.   if (Obj->VarObject.decl->Kind == kVAR_DECL) {
  316.   if (Obj->VarObject.decl->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  317.   if (Obj->VarObject.Dist->Kind == kNodeDistribution) {
  318. # line 184 "AdaptDistributions.puma"
  319.   {
  320. # line 187 "AdaptDistributions.puma"
  321.  perm = implied_distribution_permutation (Obj->VarObject.Dist->NodeDistribution.dims);
  322.       if (!is_id_permutation (perm))
  323.         { obj_protocol ("This variable has switched dimensions:\n", Obj);
  324.           switch_index_types (Obj->VarObject.decl->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES, perm);
  325.           obj_protocol ("this is the object with new dimensions:\n", Obj);
  326.         }
  327.        else
  328.           switch_index_types (Obj->VarObject.decl->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES, perm);
  329.  
  330.   }
  331.    return;
  332.  
  333.   }
  334.   }
  335.   }
  336.   if (Obj->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  337.   if (Obj->VarObject.decl->VAR_PARAM_DECL.VAL->Kind == kARRAY_TYPE) {
  338.   if (Obj->VarObject.Dist->Kind == kNodeDistribution) {
  339. # line 198 "AdaptDistributions.puma"
  340.   {
  341. # line 200 "AdaptDistributions.puma"
  342.  perm = implied_distribution_permutation (Obj->VarObject.Dist->NodeDistribution.dims);
  343.       if (!is_id_permutation (perm))
  344.         { obj_protocol ("this variable has switched dimensions", Obj);
  345.           switch_index_types (Obj->VarObject.decl->VAR_PARAM_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES, perm);
  346.           obj_protocol ("this is the object with new dimensions", Obj);
  347.         }
  348.        else
  349.           switch_index_types (Obj->VarObject.decl->VAR_PARAM_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES, perm);
  350.  
  351.   }
  352.    return;
  353.  
  354.   }
  355.   }
  356.   }
  357.   }
  358. # line 211 "AdaptDistributions.puma"
  359.   {
  360. # line 212 "AdaptDistributions.puma"
  361.    obj_error_protocol ("did not switch dimensions", Obj);
  362.   }
  363.    return;
  364.  
  365. ;
  366. }
  367.  
  368. static void TransformACFDistributions
  369. # if defined __STDC__ | defined __cplusplus
  370. (register tTree t)
  371. # else
  372. (t)
  373.  register tTree t;
  374. # endif
  375. {
  376. # line 223 "AdaptDistributions.puma"
  377.  
  378. Permutation perm;
  379.  
  380.   if (t == NoTree) return;
  381.  
  382.   switch (t->Kind) {
  383.   case kACF_LIST:
  384. # line 227 "AdaptDistributions.puma"
  385.   {
  386. # line 228 "AdaptDistributions.puma"
  387.    set_protocol_stmt (t->ACF_LIST.Elem);
  388. # line 229 "AdaptDistributions.puma"
  389.    TransformACFDistributions (t->ACF_LIST.Elem);
  390. # line 230 "AdaptDistributions.puma"
  391.    TransformACFDistributions (t->ACF_LIST.Next);
  392.   }
  393.    return;
  394.  
  395.   case kACF_EMPTY:
  396. # line 233 "AdaptDistributions.puma"
  397.    return;
  398.  
  399.   case kACF_DUMMY:
  400. # line 236 "AdaptDistributions.puma"
  401.    return;
  402.  
  403.   case kACF_BASIC:
  404. # line 239 "AdaptDistributions.puma"
  405.   {
  406. # line 240 "AdaptDistributions.puma"
  407.    TransformStmtDistributions (t->ACF_BASIC.BASIC_STMT);
  408.   }
  409.    return;
  410.  
  411.   case kACF_IF:
  412. # line 243 "AdaptDistributions.puma"
  413.   {
  414. # line 244 "AdaptDistributions.puma"
  415.    perm = PermuteExpression (t->ACF_IF.IF_EXP);
  416. # line 245 "AdaptDistributions.puma"
  417.    TransformACFDistributions (t->ACF_IF.THEN_PART);
  418. # line 246 "AdaptDistributions.puma"
  419.    TransformACFDistributions (t->ACF_IF.ELSE_PART);
  420.   }
  421.    return;
  422.  
  423.   case kACF_WHERE:
  424. # line 249 "AdaptDistributions.puma"
  425.   {
  426. # line 251 "AdaptDistributions.puma"
  427.    perm = PermuteExpression (t->ACF_WHERE.WHERE_EXP);
  428. # line 252 "AdaptDistributions.puma"
  429.    WherePermutation (t->ACF_WHERE.TRUE_PART, perm);
  430. # line 253 "AdaptDistributions.puma"
  431.    WherePermutation (t->ACF_WHERE.FALSE_PART, perm);
  432.   }
  433.    return;
  434.  
  435.   case kACF_CASE:
  436. # line 256 "AdaptDistributions.puma"
  437.   {
  438. # line 257 "AdaptDistributions.puma"
  439.    perm = PermuteExpression (t->ACF_CASE.CASE_EXP);
  440. # line 258 "AdaptDistributions.puma"
  441.    TransformACFDistributions (t->ACF_CASE.CASE_ALTS);
  442. # line 259 "AdaptDistributions.puma"
  443.    TransformACFDistributions (t->ACF_CASE.CASE_OTHERWISE);
  444.   }
  445.    return;
  446.  
  447.   case kSELECTED_ACF_LIST:
  448. # line 262 "AdaptDistributions.puma"
  449.   {
  450. # line 263 "AdaptDistributions.puma"
  451.    TransformACFDistributions (t->SELECTED_ACF_LIST.Elem);
  452. # line 264 "AdaptDistributions.puma"
  453.    TransformACFDistributions (t->SELECTED_ACF_LIST.Next);
  454.   }
  455.    return;
  456.  
  457.   case kSELECTED_ACF_EMPTY:
  458. # line 267 "AdaptDistributions.puma"
  459.    return;
  460.  
  461.   case kSELECTED_ACF_NODE:
  462. # line 270 "AdaptDistributions.puma"
  463.   {
  464. # line 271 "AdaptDistributions.puma"
  465.    perm = PermuteExpression (t->SELECTED_ACF_NODE.SELECT_LIST);
  466. # line 272 "AdaptDistributions.puma"
  467.    TransformACFDistributions (t->SELECTED_ACF_NODE.SELECT_ACFS);
  468.   }
  469.    return;
  470.  
  471.   case kACF_WHILE:
  472. # line 275 "AdaptDistributions.puma"
  473.   {
  474. # line 276 "AdaptDistributions.puma"
  475.    perm = PermuteExpression (t->ACF_WHILE.WHILE_EXP);
  476. # line 277 "AdaptDistributions.puma"
  477.    TransformACFDistributions (t->ACF_WHILE.WHILE_BODY);
  478.   }
  479.    return;
  480.  
  481.   case kACF_FORALL:
  482. # line 280 "AdaptDistributions.puma"
  483.   {
  484. # line 281 "AdaptDistributions.puma"
  485.    perm = PermuteExpression (t->ACF_FORALL.FORALL_RANGE);
  486. # line 282 "AdaptDistributions.puma"
  487.    TransformACFDistributions (t->ACF_FORALL.FORALL_BODY);
  488.   }
  489.    return;
  490.  
  491.   case kACF_DOLOCAL:
  492. # line 285 "AdaptDistributions.puma"
  493.   {
  494. # line 286 "AdaptDistributions.puma"
  495.    perm = PermuteExpression (t->ACF_DOLOCAL.DOLOCAL_RANGE);
  496. # line 287 "AdaptDistributions.puma"
  497.    TransformACFDistributions (t->ACF_DOLOCAL.DOLOCAL_BODY);
  498.   }
  499.    return;
  500.  
  501.   case kACF_DO:
  502. # line 290 "AdaptDistributions.puma"
  503.   {
  504. # line 291 "AdaptDistributions.puma"
  505.    perm = PermuteExpression (t->ACF_DO.DO_RANGE);
  506. # line 292 "AdaptDistributions.puma"
  507.    TransformACFDistributions (t->ACF_DO.DO_BODY);
  508.   }
  509.    return;
  510.  
  511.   }
  512.  
  513. # line 295 "AdaptDistributions.puma"
  514.   {
  515. # line 296 "AdaptDistributions.puma"
  516.    failure_protocol ("AdaptDistributions", "TransformACFDistriubtions", t);
  517.   }
  518.    return;
  519.  
  520. ;
  521. }
  522.  
  523. static void WherePermutation
  524. # if defined __STDC__ | defined __cplusplus
  525. (register tTree t, Permutation p)
  526. # else
  527. (t, p)
  528.  register tTree t;
  529.  Permutation p;
  530. # endif
  531. {
  532.   if (t == NoTree) return;
  533.   if (t->Kind == kACF_LIST) {
  534. # line 309 "AdaptDistributions.puma"
  535.   {
  536. # line 310 "AdaptDistributions.puma"
  537.    WherePermutation (t->ACF_LIST.Elem, p);
  538. # line 311 "AdaptDistributions.puma"
  539.    WherePermutation (t->ACF_LIST.Next, p);
  540.   }
  541.    return;
  542.  
  543.   }
  544.   if (t->Kind == kACF_EMPTY) {
  545. # line 314 "AdaptDistributions.puma"
  546.    return;
  547.  
  548.   }
  549.   if (t->Kind == kACF_BASIC) {
  550.   if (t->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  551. # line 317 "AdaptDistributions.puma"
  552.  {
  553.   Permutation perm;
  554.   Permutation perm1;
  555.   {
  556. # line 319 "AdaptDistributions.puma"
  557.  
  558. # line 320 "AdaptDistributions.puma"
  559.  
  560. # line 322 "AdaptDistributions.puma"
  561.    perm = PermuteExpression (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR);
  562. # line 323 "AdaptDistributions.puma"
  563.    perm1 = PermuteExpression (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP);
  564. # line 325 "AdaptDistributions.puma"
  565.  if (perm1.n > 0)
  566.       { if (!equal_permutations (perm, perm1))
  567.            error_protocol ("implicit transpose in where-assignment");
  568.       }
  569.      if (!equal_permutations (p, perm))
  570.        error_protocol ("implicit transpose with where expression");
  571.  
  572.   }
  573.    return;
  574.  }
  575.  
  576.   }
  577.   }
  578. # line 334 "AdaptDistributions.puma"
  579.   {
  580. # line 335 "AdaptDistributions.puma"
  581.    failure_protocol ("AdaptDistributions", "WherePermutation", t);
  582.   }
  583.    return;
  584.  
  585. ;
  586. }
  587.  
  588. static void TransformStmtDistributions
  589. # if defined __STDC__ | defined __cplusplus
  590. (register tTree t)
  591. # else
  592. (t)
  593.  register tTree t;
  594. # endif
  595. {
  596. # line 346 "AdaptDistributions.puma"
  597.  
  598. Permutation perm, perm1;
  599.  
  600.   if (t == NoTree) return;
  601.  
  602.   switch (t->Kind) {
  603.   case kASSIGN_STMT:
  604. # line 350 "AdaptDistributions.puma"
  605.   {
  606. # line 351 "AdaptDistributions.puma"
  607.    perm = PermuteExpression (t->ASSIGN_STMT.ASSIGN_VAR);
  608. # line 352 "AdaptDistributions.puma"
  609.    perm1 = PermuteExpression (t->ASSIGN_STMT.ASSIGN_EXP);
  610. # line 353 "AdaptDistributions.puma"
  611.  if (!conform_permutations (perm, perm1))
  612.         ResolveDistTranspose (t, perm, perm1);
  613.  
  614.   }
  615.    return;
  616.  
  617.   case kFORMAT_STMT:
  618. # line 358 "AdaptDistributions.puma"
  619.    return;
  620.  
  621.   case kIO_STMT:
  622. # line 362 "AdaptDistributions.puma"
  623.   {
  624. # line 364 "AdaptDistributions.puma"
  625.    TransformParamDistributions (t->IO_STMT.IO_ITEMS, false);
  626.   }
  627.    return;
  628.  
  629.   case kCALL_STMT:
  630. # line 367 "AdaptDistributions.puma"
  631.   {
  632. # line 369 "AdaptDistributions.puma"
  633.    if (! (t->CALL_STMT.CALL_ID->PROC_OBJ.Object == GetDeclEntry (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident, GetIntrinsicEntries ()))) goto yyL4;
  634.   {
  635. # line 373 "AdaptDistributions.puma"
  636.    PermuteIntrinsicSubroutine (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident, t->CALL_STMT.CALL_PARAMS);
  637.   }
  638.   }
  639.    return;
  640. yyL4:;
  641.  
  642. # line 376 "AdaptDistributions.puma"
  643.   {
  644. # line 378 "AdaptDistributions.puma"
  645.    if (! (t->CALL_STMT.CALL_ID->PROC_OBJ.Object == GetDeclEntry (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident, GetExternalEntries ()))) goto yyL5;
  646.   {
  647. # line 382 "AdaptDistributions.puma"
  648.    TransformParamDistributions (t->CALL_STMT.CALL_PARAMS, false);
  649.   }
  650.   }
  651.    return;
  652. yyL5:;
  653.  
  654. # line 385 "AdaptDistributions.puma"
  655.   {
  656. # line 386 "AdaptDistributions.puma"
  657.    TransformParamDistributions (t->CALL_STMT.CALL_PARAMS, true);
  658.   }
  659.    return;
  660.  
  661.   case kREDUCE_STMT:
  662. # line 389 "AdaptDistributions.puma"
  663.   {
  664. # line 390 "AdaptDistributions.puma"
  665.    TransformParamDistributions (t->REDUCE_STMT.RED_PARAMS, false);
  666.   }
  667.    return;
  668.  
  669.   case kALLOCATE_STMT:
  670. # line 393 "AdaptDistributions.puma"
  671.   {
  672. # line 394 "AdaptDistributions.puma"
  673.    TransformParamDistributions (t->ALLOCATE_STMT.PARAMS, true);
  674.   }
  675.    return;
  676.  
  677.   case kDEALLOCATE_STMT:
  678. # line 397 "AdaptDistributions.puma"
  679.   {
  680. # line 398 "AdaptDistributions.puma"
  681.    TransformParamDistributions (t->DEALLOCATE_STMT.PARAMS, true);
  682.   }
  683.    return;
  684.  
  685.   case kGOTO_STMT:
  686. # line 401 "AdaptDistributions.puma"
  687.    return;
  688.  
  689.   case kCOMP_GOTO_STMT:
  690. # line 404 "AdaptDistributions.puma"
  691.   {
  692. # line 405 "AdaptDistributions.puma"
  693.    perm = PermuteExpression (t->COMP_GOTO_STMT.GOTO_EXP);
  694.   }
  695.    return;
  696.  
  697.   case kCOMP_IF_STMT:
  698. # line 408 "AdaptDistributions.puma"
  699.   {
  700. # line 409 "AdaptDistributions.puma"
  701.    perm = PermuteExpression (t->COMP_IF_STMT.IF_EXP);
  702.   }
  703.    return;
  704.  
  705.   case kSTOP_STMT:
  706. # line 412 "AdaptDistributions.puma"
  707.   {
  708. # line 413 "AdaptDistributions.puma"
  709.    perm = PermuteExpression (t->STOP_STMT.STOP_CONST);
  710.   }
  711.    return;
  712.  
  713.   case kRETURN_STMT:
  714. # line 416 "AdaptDistributions.puma"
  715.   {
  716. # line 417 "AdaptDistributions.puma"
  717.    perm = PermuteExpression (t->RETURN_STMT.RETURN_EXP);
  718.   }
  719.    return;
  720.  
  721.   }
  722.  
  723. # line 420 "AdaptDistributions.puma"
  724.   {
  725. # line 421 "AdaptDistributions.puma"
  726.    failure_protocol ("AdaptDistributions", "TransformStmtDistributions", t);
  727.   }
  728.    return;
  729.  
  730. ;
  731. }
  732.  
  733. static void TransformParamDistributions
  734. # if defined __STDC__ | defined __cplusplus
  735. (register tTree t, register bool allowed)
  736. # else
  737. (t, allowed)
  738.  register tTree t;
  739.  register bool allowed;
  740. # endif
  741. {
  742.   if (t == NoTree) return;
  743.   if (t->Kind == kBTP_LIST) {
  744. # line 428 "AdaptDistributions.puma"
  745.   {
  746. # line 429 "AdaptDistributions.puma"
  747.    TransformParamDistributions (t->BTP_LIST.Elem, allowed);
  748. # line 430 "AdaptDistributions.puma"
  749.    TransformParamDistributions (t->BTP_LIST.Next, allowed);
  750.   }
  751.    return;
  752.  
  753.   }
  754.   if (t->Kind == kBTP_EMPTY) {
  755. # line 433 "AdaptDistributions.puma"
  756.    return;
  757.  
  758.   }
  759.   if (t->Kind == kVAR_PARAM) {
  760. # line 436 "AdaptDistributions.puma"
  761.  {
  762.   Permutation p;
  763.   {
  764. # line 437 "AdaptDistributions.puma"
  765.  
  766. # line 438 "AdaptDistributions.puma"
  767.    p = PermuteExpression (t->VAR_PARAM.V);
  768. # line 439 "AdaptDistributions.puma"
  769.  if (!allowed)
  770.         {
  771.           if (!equal_permutations (p, make_id_permutation (p.n)))
  772.              error_protocol ("implicit transformation in parameter");
  773.         }
  774.  
  775.   }
  776.    return;
  777.  }
  778.  
  779.   }
  780.   if (t->Kind == kFUNC_PARAM) {
  781. # line 447 "AdaptDistributions.puma"
  782.    return;
  783.  
  784.   }
  785.   if (t->Kind == kPROC_PARAM) {
  786. # line 450 "AdaptDistributions.puma"
  787.    return;
  788.  
  789.   }
  790. # line 453 "AdaptDistributions.puma"
  791.   {
  792. # line 454 "AdaptDistributions.puma"
  793.    failure_protocol ("AdaptDistributions", "TransformParamDistributions", t);
  794.   }
  795.    return;
  796.  
  797. ;
  798. }
  799.  
  800. static void TransformIndexDistributions
  801. # if defined __STDC__ | defined __cplusplus
  802. (register tTree t)
  803. # else
  804. (t)
  805.  register tTree t;
  806. # endif
  807. {
  808.   if (t == NoTree) return;
  809.   if (t->Kind == kBTE_LIST) {
  810. # line 459 "AdaptDistributions.puma"
  811.  {
  812.   Permutation p;
  813.   {
  814. # line 460 "AdaptDistributions.puma"
  815.  
  816. # line 461 "AdaptDistributions.puma"
  817.    p = PermuteExpression (t->BTE_LIST.Elem);
  818. # line 462 "AdaptDistributions.puma"
  819.    TransformIndexDistributions (t->BTE_LIST.Next);
  820.   }
  821.    return;
  822.  }
  823.  
  824.   }
  825.   if (t->Kind == kBTE_EMPTY) {
  826. # line 465 "AdaptDistributions.puma"
  827.    return;
  828.  
  829.   }
  830.   if (t->Kind == kBTV_LIST) {
  831. # line 468 "AdaptDistributions.puma"
  832.  {
  833.   Permutation p;
  834.   {
  835. # line 469 "AdaptDistributions.puma"
  836.  
  837. # line 470 "AdaptDistributions.puma"
  838.    p = PermuteExpression (t->BTV_LIST.Elem);
  839. # line 471 "AdaptDistributions.puma"
  840.    TransformIndexDistributions (t->BTV_LIST.Next);
  841.   }
  842.    return;
  843.  }
  844.  
  845.   }
  846.   if (t->Kind == kBTV_EMPTY) {
  847. # line 474 "AdaptDistributions.puma"
  848.    return;
  849.  
  850.   }
  851. # line 477 "AdaptDistributions.puma"
  852.   {
  853. # line 478 "AdaptDistributions.puma"
  854.    failure_protocol ("AdaptDistributions", "TransformIndexDistributions", t);
  855.   }
  856.    return;
  857.  
  858. ;
  859. }
  860.  
  861. static Permutation PermuteExpression
  862. # if defined __STDC__ | defined __cplusplus
  863. (register tTree t)
  864. # else
  865. (t)
  866.  register tTree t;
  867. # endif
  868. {
  869. # line 492 "AdaptDistributions.puma"
  870.  
  871. Permutation perm, perm1;
  872.  
  873.  
  874.   switch (t->Kind) {
  875.   case kUSED_VAR:
  876. # line 496 "AdaptDistributions.puma"
  877.    return GetObjectPermutation (t->USED_VAR.VARNAME->VAR_OBJ.Object);
  878.  
  879.   case kSUBSTRING_VAR:
  880. # line 500 "AdaptDistributions.puma"
  881.    return PermuteExpression (t->SUBSTRING_VAR.IND_VAR);
  882.  
  883.   case kLOOP_VAR:
  884. # line 504 "AdaptDistributions.puma"
  885.    return GetObjectPermutation (t->LOOP_VAR.LOOP_VARNAME->VAR_OBJ.Object);
  886.  
  887.   case kINDEXED_VAR:
  888. # line 508 "AdaptDistributions.puma"
  889.   {
  890. # line 512 "AdaptDistributions.puma"
  891.    TransformIndexDistributions (t->INDEXED_VAR.IND_EXPS);
  892. # line 514 "AdaptDistributions.puma"
  893.    perm = PermuteExpression (t->INDEXED_VAR.IND_VAR);
  894. # line 516 "AdaptDistributions.puma"
  895.    perm1 = index_list (t->INDEXED_VAR.IND_EXPS);
  896. # line 518 "AdaptDistributions.puma"
  897.    switch_indexes (t->INDEXED_VAR.IND_EXPS, perm);
  898. # line 520 "AdaptDistributions.puma"
  899.    perm1 = get_rank_permutation (perm1, perm);
  900.   }
  901.    return perm1;
  902.  
  903.   case kDO_VAR:
  904. # line 525 "AdaptDistributions.puma"
  905.   {
  906. # line 526 "AdaptDistributions.puma"
  907.    perm = PermuteExpression (t->DO_VAR.RANGE);
  908. # line 527 "AdaptDistributions.puma"
  909.    TransformIndexDistributions (t->DO_VAR.BODY);
  910.   }
  911.    return PermuteExpression (t->DO_VAR.DO_ID);
  912.  
  913.   case kADDR:
  914. # line 531 "AdaptDistributions.puma"
  915.    return PermuteExpression (t->ADDR.E);
  916.  
  917.   case kDUMMY_EXP:
  918. # line 535 "AdaptDistributions.puma"
  919.    return make_id_permutation (0);
  920.  
  921.   case kCONST_EXP:
  922. # line 539 "AdaptDistributions.puma"
  923.    return make_id_permutation (0);
  924.  
  925.   case kARRAY_EXP:
  926. # line 543 "AdaptDistributions.puma"
  927.    return make_id_permutation (1);
  928.  
  929.   case kSLICE_EXP:
  930. # line 547 "AdaptDistributions.puma"
  931.   {
  932. # line 548 "AdaptDistributions.puma"
  933.    perm = PermuteExpression (t->SLICE_EXP.START);
  934. # line 549 "AdaptDistributions.puma"
  935.    perm = PermuteExpression (t->SLICE_EXP.STOP);
  936. # line 550 "AdaptDistributions.puma"
  937.    perm = PermuteExpression (t->SLICE_EXP.INC);
  938.   }
  939.    return make_id_permutation (1);
  940.  
  941.   case kOP_EXP:
  942. # line 554 "AdaptDistributions.puma"
  943.   {
  944. # line 556 "AdaptDistributions.puma"
  945.    perm = PermuteExpression (t->OP_EXP.OPND1);
  946. # line 557 "AdaptDistributions.puma"
  947.    perm1 = PermuteExpression (t->OP_EXP.OPND2);
  948. # line 559 "AdaptDistributions.puma"
  949.  if (!conform_permutations (perm, perm1))
  950.          { error_protocol ("implicit transpose in expression");
  951.            tree_protocol ("expression is : ", t);
  952.          }
  953.  
  954.   }
  955.    return merge_permutation (perm, perm1);
  956.  
  957.   case kOP1_EXP:
  958. # line 567 "AdaptDistributions.puma"
  959.    return PermuteExpression (t->OP1_EXP.OPND);
  960.  
  961.   case kVAR_EXP:
  962. # line 571 "AdaptDistributions.puma"
  963.    return PermuteExpression (t->VAR_EXP.V);
  964.  
  965.   case kFUNC_CALL_EXP:
  966. # line 575 "AdaptDistributions.puma"
  967.   {
  968. # line 577 "AdaptDistributions.puma"
  969.    if (! (IsIntrFunc (t) == true)) goto yyL14;
  970.   }
  971.    return PermuteIntrinsicFunction (t);
  972. yyL14:;
  973.  
  974. # line 581 "AdaptDistributions.puma"
  975.   {
  976. # line 585 "AdaptDistributions.puma"
  977.    TransformParamDistributions (t->FUNC_CALL_EXP.FUNC_PARAMS, true);
  978.   }
  979.    return make_id_permutation (0);
  980.  
  981.   case kDO_EXP:
  982. # line 589 "AdaptDistributions.puma"
  983.    return make_id_permutation (1);
  984.  
  985.   case kVAR_PARAM:
  986. # line 593 "AdaptDistributions.puma"
  987.    return PermuteExpression (t->VAR_PARAM.V);
  988.  
  989.   }
  990.  
  991. # line 597 "AdaptDistributions.puma"
  992.   {
  993. # line 598 "AdaptDistributions.puma"
  994.    failure_protocol ("AdaptDistributions", "PermuteExpression", t);
  995.   }
  996.    return make_id_permutation (0);
  997.  
  998. }
  999.  
  1000. static Permutation GetObjectPermutation
  1001. # if defined __STDC__ | defined __cplusplus
  1002. (register tDefinitions obj)
  1003. # else
  1004. (obj)
  1005.  register tDefinitions obj;
  1006. # endif
  1007. {
  1008.   if (obj->Kind == kVarObject) {
  1009.   if (obj->VarObject.Dist->Kind == kNodeDistribution) {
  1010. # line 611 "AdaptDistributions.puma"
  1011.    return implied_distribution_permutation (obj->VarObject.Dist->NodeDistribution.dims);
  1012.  
  1013.   }
  1014. # line 615 "AdaptDistributions.puma"
  1015.    return make_id_permutation (VarRank (obj));
  1016.  
  1017.   }
  1018.   if (obj->Kind == kFuncObject) {
  1019.   if (obj->FuncObject.decl->Kind == kFUNC_DECL) {
  1020. # line 619 "AdaptDistributions.puma"
  1021.    return make_id_permutation (0);
  1022.  
  1023.   }
  1024.   }
  1025. # line 624 "AdaptDistributions.puma"
  1026.   {
  1027. # line 625 "AdaptDistributions.puma"
  1028.    obj_error_protocol ("GetObjectPermutation failed", obj);
  1029.   }
  1030.    return make_id_permutation (0);
  1031.  
  1032. }
  1033.  
  1034. static Permutation PermuteIntrinsicFunction
  1035. # if defined __STDC__ | defined __cplusplus
  1036. (register tTree f)
  1037. # else
  1038. (f)
  1039.  register tTree f;
  1040. # endif
  1041. {
  1042.   if (f->Kind == kFUNC_CALL_EXP) {
  1043. # line 637 "AdaptDistributions.puma"
  1044.   {
  1045. # line 638 "AdaptDistributions.puma"
  1046.    if (! (IntrFuncKind1 (f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident) == true)) goto yyL1;
  1047.   }
  1048.    return PermuteIntrinsicParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
  1049. yyL1:;
  1050.  
  1051. # line 642 "AdaptDistributions.puma"
  1052.   {
  1053. # line 643 "AdaptDistributions.puma"
  1054.    if (! (IntrFuncKind2 (f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident) == true)) goto yyL2;
  1055.   }
  1056.    return PermuteIntrinsicParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
  1057. yyL2:;
  1058.  
  1059. # line 647 "AdaptDistributions.puma"
  1060.   {
  1061. # line 648 "AdaptDistributions.puma"
  1062.    if (! (IntrFuncKindn (f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident) == true)) goto yyL3;
  1063.   }
  1064.    return PermuteIntrinsicParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
  1065. yyL3:;
  1066.  
  1067. # line 652 "AdaptDistributions.puma"
  1068.   {
  1069. # line 653 "AdaptDistributions.puma"
  1070.    if (! (IntrFuncRed (f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident) == true)) goto yyL4;
  1071.   }
  1072.    return PermuteReductionParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
  1073. yyL4:;
  1074.  
  1075. # line 657 "AdaptDistributions.puma"
  1076.   {
  1077. # line 658 "AdaptDistributions.puma"
  1078.    if (! ((f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident == MakeIdent ("CSHIFT", 6)))) goto yyL5;
  1079.   }
  1080.    return PermuteCShiftParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
  1081. yyL5:;
  1082.  
  1083. # line 662 "AdaptDistributions.puma"
  1084.   {
  1085. # line 663 "AdaptDistributions.puma"
  1086.    if (! ((f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident == MakeIdent ("SPREAD", 6)))) goto yyL6;
  1087.   }
  1088.    return PermuteSpreadParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
  1089. yyL6:;
  1090.  
  1091. # line 667 "AdaptDistributions.puma"
  1092.   {
  1093. # line 668 "AdaptDistributions.puma"
  1094.    if (! ((f->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident == MakeIdent ("TRANSPOSE", 9)))) goto yyL7;
  1095.   }
  1096.    return PermuteTransposeParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
  1097. yyL7:;
  1098.  
  1099. # line 672 "AdaptDistributions.puma"
  1100.   {
  1101. # line 673 "AdaptDistributions.puma"
  1102.    error_protocol ("intrinsic not handled");
  1103. # line 674 "AdaptDistributions.puma"
  1104.    tree_protocol ("intrinsic function is : ", f);
  1105.   }
  1106.    return PermuteIntrinsicParameters (f->FUNC_CALL_EXP.FUNC_PARAMS);
  1107.  
  1108.   }
  1109.  yyAbort ("PermuteIntrinsicFunction");
  1110. }
  1111.  
  1112. static Permutation PermuteIntrinsicParameters
  1113. # if defined __STDC__ | defined __cplusplus
  1114. (register tTree p)
  1115. # else
  1116. (p)
  1117.  register tTree p;
  1118. # endif
  1119. {
  1120.   if (p->Kind == kBTP_LIST) {
  1121. # line 680 "AdaptDistributions.puma"
  1122.  {
  1123.   Permutation perm1;
  1124.   Permutation perm2;
  1125.   {
  1126. # line 682 "AdaptDistributions.puma"
  1127.  
  1128. # line 683 "AdaptDistributions.puma"
  1129.  
  1130. # line 685 "AdaptDistributions.puma"
  1131.    perm1 = PermuteExpression (p->BTP_LIST.Elem);
  1132. # line 686 "AdaptDistributions.puma"
  1133.    perm2 = PermuteIntrinsicParameters (p->BTP_LIST.Next);
  1134. # line 688 "AdaptDistributions.puma"
  1135.   if (!conform_permutations (perm1, perm2))
  1136.          error_protocol ("implicit transpose in expression");
  1137.  
  1138.   }
  1139.   {
  1140.    return merge_permutation (perm1, perm2);
  1141.   }
  1142.  }
  1143.  
  1144.   }
  1145.   if (p->Kind == kBTP_EMPTY) {
  1146. # line 695 "AdaptDistributions.puma"
  1147.    return make_id_permutation (0);
  1148.  
  1149.   }
  1150.  yyAbort ("PermuteIntrinsicParameters");
  1151. }
  1152.  
  1153. static Permutation PermuteReductionParameters
  1154. # if defined __STDC__ | defined __cplusplus
  1155. (register tTree p)
  1156. # else
  1157. (p)
  1158.  register tTree p;
  1159. # endif
  1160. {
  1161.   if (p->Kind == kBTP_LIST) {
  1162.   if (p->BTP_LIST.Next->Kind == kBTP_EMPTY) {
  1163. # line 709 "AdaptDistributions.puma"
  1164.    return PermuteExpression (p->BTP_LIST.Elem);
  1165.  
  1166.   }
  1167.   if (p->BTP_LIST.Next->Kind == kBTP_LIST) {
  1168.   if (p->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_EMPTY) {
  1169. # line 726 "AdaptDistributions.puma"
  1170.  {
  1171.   Permutation array_perm;
  1172.   int idim;
  1173.   int ndim;
  1174.   bool found;
  1175.   {
  1176. # line 728 "AdaptDistributions.puma"
  1177.  
  1178. # line 729 "AdaptDistributions.puma"
  1179.  
  1180. # line 730 "AdaptDistributions.puma"
  1181.  
  1182. # line 731 "AdaptDistributions.puma"
  1183.  
  1184. # line 733 "AdaptDistributions.puma"
  1185.    array_perm = PermuteExpression (p->BTP_LIST.Elem);
  1186. # line 735 "AdaptDistributions.puma"
  1187.  GetIntConstValue (p->BTP_LIST.Next->BTP_LIST.Elem, &found, &idim);
  1188.      if (is_id_permutation (array_perm))
  1189.         array_perm = make_id_permutation (array_perm.n - 1);
  1190.        else if (!found)
  1191.         error_protocol ("unknown dim parameter in reduction (transpose?)");
  1192.        else
  1193.          { ndim = new_perm_position (array_perm, idim);
  1194.            p->BTP_LIST.Next->BTP_LIST.Elem = ChangeConstValue (p->BTP_LIST.Next->BTP_LIST.Elem, ndim);
  1195.            array_perm = reduce_permutation (array_perm, idim, ndim);
  1196.            stmt_protocol ("reduction has changed dimension");
  1197.          }
  1198.  
  1199.   }
  1200.   {
  1201.    return array_perm;
  1202.   }
  1203.  }
  1204.  
  1205.   }
  1206.   }
  1207.   }
  1208.  yyAbort ("PermuteReductionParameters");
  1209. }
  1210.  
  1211. static Permutation PermuteCShiftParameters
  1212. # if defined __STDC__ | defined __cplusplus
  1213. (register tTree p)
  1214. # else
  1215. (p)
  1216.  register tTree p;
  1217. # endif
  1218. {
  1219.   if (p->Kind == kBTP_LIST) {
  1220.   if (p->BTP_LIST.Next->Kind == kBTP_LIST) {
  1221.   if (p->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_LIST) {
  1222.   if (p->BTP_LIST.Next->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_EMPTY) {
  1223. # line 768 "AdaptDistributions.puma"
  1224.  {
  1225.   Permutation array_perm;
  1226.   int idim;
  1227.   bool found;
  1228.   {
  1229. # line 770 "AdaptDistributions.puma"
  1230.  
  1231. # line 772 "AdaptDistributions.puma"
  1232.    array_perm = PermuteExpression (p->BTP_LIST.Elem);
  1233. # line 774 "AdaptDistributions.puma"
  1234.  
  1235. # line 775 "AdaptDistributions.puma"
  1236.  
  1237. # line 777 "AdaptDistributions.puma"
  1238.  GetIntConstValue (p->BTP_LIST.Next->BTP_LIST.Elem, &found, &idim);
  1239.      if (is_id_permutation (array_perm))
  1240.         idim = idim;
  1241.        else if (!found)
  1242.         error_protocol ("unknown dim parameter in cshift (transpose?)");
  1243.        else
  1244.          { idim = new_perm_position (array_perm, idim);
  1245.            p->BTP_LIST.Next->BTP_LIST.Elem = ChangeConstValue (p->BTP_LIST.Next->BTP_LIST.Elem, idim);
  1246.          }
  1247.  
  1248.   }
  1249.   {
  1250.    return array_perm;
  1251.   }
  1252.  }
  1253.  
  1254.   }
  1255.   }
  1256.   }
  1257.   }
  1258.  yyAbort ("PermuteCShiftParameters");
  1259. }
  1260.  
  1261. static Permutation PermuteTransposeParameters
  1262. # if defined __STDC__ | defined __cplusplus
  1263. (register tTree p)
  1264. # else
  1265. (p)
  1266.  register tTree p;
  1267. # endif
  1268. {
  1269.   if (p->Kind == kBTP_LIST) {
  1270.   if (p->BTP_LIST.Next->Kind == kBTP_EMPTY) {
  1271. # line 800 "AdaptDistributions.puma"
  1272.  {
  1273.   Permutation array_perm;
  1274.   {
  1275. # line 802 "AdaptDistributions.puma"
  1276.  
  1277. # line 804 "AdaptDistributions.puma"
  1278.    array_perm = PermuteExpression (p->BTP_LIST.Elem);
  1279. # line 806 "AdaptDistributions.puma"
  1280.  if (!is_id_permutation (array_perm))
  1281.         error_protocol ("array in transpose is already transposed");
  1282.  
  1283.   }
  1284.   {
  1285.    return array_perm;
  1286.   }
  1287.  }
  1288.  
  1289.   }
  1290.   }
  1291.  yyAbort ("PermuteTransposeParameters");
  1292. }
  1293.  
  1294. static Permutation PermuteSpreadParameters
  1295. # if defined __STDC__ | defined __cplusplus
  1296. (register tTree p)
  1297. # else
  1298. (p)
  1299.  register tTree p;
  1300. # endif
  1301. {
  1302.   if (p->Kind == kBTP_LIST) {
  1303.   if (p->BTP_LIST.Next->Kind == kBTP_LIST) {
  1304.   if (p->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_LIST) {
  1305.   if (p->BTP_LIST.Next->BTP_LIST.Next->BTP_LIST.Next->Kind == kBTP_EMPTY) {
  1306. # line 827 "AdaptDistributions.puma"
  1307.  {
  1308.   Permutation array_perm;
  1309.   {
  1310. # line 829 "AdaptDistributions.puma"
  1311.  
  1312. # line 831 "AdaptDistributions.puma"
  1313.    array_perm = PermuteExpression (p->BTP_LIST.Elem);
  1314. # line 833 "AdaptDistributions.puma"
  1315.  array_perm.pa[array_perm.n] = array_perm.n + 1;
  1316.      array_perm.n = array_perm.n + 1;
  1317.  
  1318.   }
  1319.   {
  1320.    return array_perm;
  1321.   }
  1322.  }
  1323.  
  1324.   }
  1325.   }
  1326.   }
  1327.   }
  1328.  yyAbort ("PermuteSpreadParameters");
  1329. }
  1330.  
  1331. static tTree ChangeConstValue
  1332. # if defined __STDC__ | defined __cplusplus
  1333. (register tTree exp, register int val)
  1334. # else
  1335. (exp, val)
  1336.  register tTree exp;
  1337.  register int val;
  1338. # endif
  1339. {
  1340.   if (exp->Kind == kVAR_PARAM) {
  1341.   if (exp->VAR_PARAM.V->Kind == kADDR) {
  1342. # line 847 "AdaptDistributions.puma"
  1343.   {
  1344. # line 848 "AdaptDistributions.puma"
  1345.  exp->VAR_PARAM.V->ADDR.E = ChangeConstValue (exp->VAR_PARAM.V->ADDR.E, val);
  1346.   }
  1347.    return exp;
  1348.  
  1349.   }
  1350. # line 852 "AdaptDistributions.puma"
  1351.   {
  1352. # line 853 "AdaptDistributions.puma"
  1353.  exp->VAR_PARAM.V = mADDR (mCONST_EXP (mINT_CONSTANT (val)));
  1354.   }
  1355.    return exp;
  1356.  
  1357.   }
  1358.   if (exp->Kind == kCONST_EXP) {
  1359.   if (exp->CONST_EXP.C->Kind == kINT_CONSTANT) {
  1360. # line 857 "AdaptDistributions.puma"
  1361.   {
  1362. # line 858 "AdaptDistributions.puma"
  1363.  exp->CONST_EXP.C->INT_CONSTANT.value = val;
  1364.   }
  1365.    return exp;
  1366.  
  1367.   }
  1368.   }
  1369. # line 862 "AdaptDistributions.puma"
  1370.    return mCONST_EXP (mINT_CONSTANT (val));
  1371.  
  1372. }
  1373.  
  1374. static void PermuteIntrinsicSubroutine
  1375. # if defined __STDC__ | defined __cplusplus
  1376. (register tIdent name, register tTree params)
  1377. # else
  1378. (name, params)
  1379.  register tIdent name;
  1380.  register tTree params;
  1381. # endif
  1382. {
  1383.   if (params == NoTree) return;
  1384.   if (equaltIdent (name, MakeIdent ("CMF_RANDOM", 10))) {
  1385. # line 874 "AdaptDistributions.puma"
  1386.   {
  1387. # line 875 "AdaptDistributions.puma"
  1388.    TransformParamDistributions (params, true);
  1389.   }
  1390.    return;
  1391.  
  1392.   }
  1393.   if (equaltIdent (name, MakeIdent ("CMF_RANDOMIZE", 13))) {
  1394. # line 878 "AdaptDistributions.puma"
  1395.   {
  1396. # line 879 "AdaptDistributions.puma"
  1397.    TransformParamDistributions (params, true);
  1398.   }
  1399.    return;
  1400.  
  1401.   }
  1402.   if (equaltIdent (name, MakeIdent ("WALLTIME", 8))) {
  1403. # line 882 "AdaptDistributions.puma"
  1404.   {
  1405. # line 883 "AdaptDistributions.puma"
  1406.    TransformParamDistributions (params, true);
  1407.   }
  1408.    return;
  1409.  
  1410.   }
  1411.   if (equaltIdent (name, MakeIdent ("CM_TIMER_CLEAR", 14))) {
  1412. # line 886 "AdaptDistributions.puma"
  1413.   {
  1414. # line 887 "AdaptDistributions.puma"
  1415.    TransformParamDistributions (params, true);
  1416.   }
  1417.    return;
  1418.  
  1419.   }
  1420.   if (equaltIdent (name, MakeIdent ("CM_TIMER_PRINT", 14))) {
  1421. # line 890 "AdaptDistributions.puma"
  1422.   {
  1423. # line 891 "AdaptDistributions.puma"
  1424.    TransformParamDistributions (params, true);
  1425.   }
  1426.    return;
  1427.  
  1428.   }
  1429.   if (equaltIdent (name, MakeIdent ("CM_TIMER_START", 14))) {
  1430. # line 894 "AdaptDistributions.puma"
  1431.   {
  1432. # line 895 "AdaptDistributions.puma"
  1433.    TransformParamDistributions (params, true);
  1434.   }
  1435.    return;
  1436.  
  1437.   }
  1438.   if (equaltIdent (name, MakeIdent ("CM_TIMER_STOP", 13))) {
  1439. # line 898 "AdaptDistributions.puma"
  1440.   {
  1441. # line 899 "AdaptDistributions.puma"
  1442.    TransformParamDistributions (params, true);
  1443.   }
  1444.    return;
  1445.  
  1446.   }
  1447.   if (equaltIdent (name, MakeIdent ("GLOBAL_GET", 10))) {
  1448. # line 902 "AdaptDistributions.puma"
  1449.   {
  1450. # line 903 "AdaptDistributions.puma"
  1451.    PermuteGlobalGetParams (params);
  1452.   }
  1453.    return;
  1454.  
  1455.   }
  1456.   if (equaltIdent (name, MakeIdent ("GLOBAL_SEND", 11))) {
  1457. # line 906 "AdaptDistributions.puma"
  1458.   {
  1459. # line 907 "AdaptDistributions.puma"
  1460.    PermuteGlobalSendParams (params);
  1461.   }
  1462.    return;
  1463.  
  1464.   }
  1465. # line 910 "AdaptDistributions.puma"
  1466.   {
  1467. # line 911 "AdaptDistributions.puma"
  1468.    error_protocol ("Unknown intrinsic Subroutine in Distributions");
  1469.   }
  1470.    return;
  1471.  
  1472. ;
  1473. }
  1474.  
  1475. static void PermuteGlobalGetParams
  1476. # if defined __STDC__ | defined __cplusplus
  1477. (register tTree param_list)
  1478. # else
  1479. (param_list)
  1480.  register tTree param_list;
  1481. # endif
  1482. {
  1483. # line 922 "AdaptDistributions.puma"
  1484.  
  1485. int rank;
  1486. tTree A, B, M, indexes;
  1487. Permutation perm;
  1488.  
  1489.   if (param_list == NoTree) return;
  1490. # line 928 "AdaptDistributions.puma"
  1491.   {
  1492. # line 930 "AdaptDistributions.puma"
  1493.  SplitGet (param_list, &rank, &A, &B, &indexes, &M);
  1494.  
  1495.  
  1496.  
  1497.       perm = PermuteExpression (A);
  1498.       SwitchGetSendIndexes (perm, indexes, rank);
  1499.  
  1500.       if (M != NoTree)
  1501.          SwitchGetSendIndex (perm, M);
  1502.  
  1503.  
  1504.  
  1505.       perm = PermuteExpression (B);
  1506.       switch_parameters (indexes, perm);
  1507.  
  1508.  
  1509.   }
  1510.    return;
  1511.  
  1512. ;
  1513. }
  1514.  
  1515. static void PermuteGlobalSendParams
  1516. # if defined __STDC__ | defined __cplusplus
  1517. (register tTree param_list)
  1518. # else
  1519. (param_list)
  1520.  register tTree param_list;
  1521. # endif
  1522. {
  1523. # line 957 "AdaptDistributions.puma"
  1524.  
  1525. int rank;
  1526. tTree A, B, M, indexes, op;
  1527. Permutation perm;
  1528.  
  1529.   if (param_list == NoTree) return;
  1530. # line 963 "AdaptDistributions.puma"
  1531.   {
  1532. # line 965 "AdaptDistributions.puma"
  1533.  SplitSend (param_list, &rank, &A, &B, &indexes, &M, &op);
  1534.  
  1535.  
  1536.  
  1537.       perm = PermuteExpression (A);
  1538.       SwitchGetSendIndexes (perm, indexes, rank);
  1539.  
  1540.       if (M != NoTree)
  1541.          SwitchGetSendIndex (perm, M);
  1542.  
  1543.  
  1544.  
  1545.       perm = PermuteExpression (B);
  1546.       switch_parameters (indexes, perm);
  1547.  
  1548.  
  1549.   }
  1550.    return;
  1551.  
  1552. ;
  1553. }
  1554.  
  1555. static void SwitchGetSendIndexes
  1556. # if defined __STDC__ | defined __cplusplus
  1557. (Permutation ap, register tTree indexlist, register int n)
  1558. # else
  1559. (ap, indexlist, n)
  1560.  Permutation ap;
  1561.  register tTree indexlist;
  1562.  register int n;
  1563. # endif
  1564. {
  1565.   if (indexlist == NoTree) return;
  1566.   if (equalint (n, 0)) {
  1567. # line 986 "AdaptDistributions.puma"
  1568.    return;
  1569.  
  1570.   }
  1571.   if (indexlist->Kind == kBTP_LIST) {
  1572.   if (indexlist->BTP_LIST.Elem->Kind == kVAR_PARAM) {
  1573. # line 989 "AdaptDistributions.puma"
  1574.   {
  1575. # line 991 "AdaptDistributions.puma"
  1576.    SwitchGetSendIndex (ap, indexlist->BTP_LIST.Elem->VAR_PARAM.V);
  1577. # line 992 "AdaptDistributions.puma"
  1578.    SwitchGetSendIndexes (ap, indexlist->BTP_LIST.Next, n - 1);
  1579.   }
  1580.    return;
  1581.  
  1582.   }
  1583.   }
  1584. ;
  1585. }
  1586.  
  1587. static void SwitchGetSendIndex
  1588. # if defined __STDC__ | defined __cplusplus
  1589. (Permutation ap, register tTree index)
  1590. # else
  1591. (ap, index)
  1592.  Permutation ap;
  1593.  register tTree index;
  1594. # endif
  1595. {
  1596.   if (index == NoTree) return;
  1597. # line 997 "AdaptDistributions.puma"
  1598.  {
  1599.   Permutation ip;
  1600.   {
  1601. # line 999 "AdaptDistributions.puma"
  1602.  
  1603. # line 1001 "AdaptDistributions.puma"
  1604.  ip = PermuteExpression (index);
  1605.       if (!equal_permutations (ip, ap))
  1606.        { error_protocol ("implicit transpose global get/send");
  1607.          tree_protocol ("not conform is ", index);
  1608.        }
  1609.  
  1610.   }
  1611.    return;
  1612.  }
  1613.  
  1614. ;
  1615. }
  1616.  
  1617. static void ResolveDistTranspose
  1618. # if defined __STDC__ | defined __cplusplus
  1619. (register tTree t, Permutation dist1, Permutation dist2)
  1620. # else
  1621. (t, dist1, dist2)
  1622.  register tTree t;
  1623.  Permutation dist1;
  1624.  Permutation dist2;
  1625. # endif
  1626. {
  1627.   if (t == NoTree) return;
  1628.   if (t->Kind == kASSIGN_STMT) {
  1629. # line 1022 "AdaptDistributions.puma"
  1630.  {
  1631.   tTree f;
  1632.   tTree pl;
  1633.   tIdent n;
  1634.   {
  1635. # line 1024 "AdaptDistributions.puma"
  1636.  
  1637. # line 1025 "AdaptDistributions.puma"
  1638.  
  1639. # line 1026 "AdaptDistributions.puma"
  1640.  
  1641. # line 1028 "AdaptDistributions.puma"
  1642.    if (! ((transpose_permutations (dist1, dist2) != false))) goto yyL1;
  1643.   {
  1644. # line 1030 "AdaptDistributions.puma"
  1645.  n  = MakeIdent ("TRANSPOSE", 9);
  1646.      pl = mBTP_LIST (ExpToVarParam (t->ASSIGN_STMT.ASSIGN_EXP), mBTP_EMPTY());
  1647.      f  = mPROC_OBJ (MakeIdent("TRANSPOSE",9));
  1648.      f->PROC_OBJ.Object = GetDeclEntry (n, GetIntrinsicEntries ());
  1649.      t->ASSIGN_STMT.ASSIGN_EXP = mFUNC_CALL_EXP (f, pl);
  1650.  
  1651.   }
  1652.   }
  1653.    return;
  1654.  }
  1655. yyL1:;
  1656.  
  1657.   }
  1658. # line 1038 "AdaptDistributions.puma"
  1659.   {
  1660. # line 1039 "AdaptDistributions.puma"
  1661.    error_protocol ("implicit transpose in assignment not resolved");
  1662.   }
  1663.    return;
  1664.  
  1665. ;
  1666. }
  1667.  
  1668. void BeginAdaptDistributions ()
  1669. {
  1670. }
  1671.  
  1672. void CloseAdaptDistributions ()
  1673. {
  1674. }
  1675.